perm filename BIGGET.OLD[NEW,LCS] blob
sn#333242 filedate 1978-02-09 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 TITLE BIGGET
C00013 ENDMK
C⊗;
TITLE BIGGET
ENTRY BIGGET,MOVIT,SORT2,EXCH,EXTEN
INTERNAL PUTEXT,EXTOUT,GETEXT,EXTIN,FINEXT
EXTERNAL .COMM.,XRN,KJY,PTR,NNP,MMV,RR4,AMOD,RINP
K←15↔J←14↔ M←2↔ R2←5↔ X←6↔ L←4↔ R←7↔ A←11↔RY←3↔RZ←13↔JJ2←12
; SEE JJUST ---
BIGGET: 0 ;CALL BIGGET
SETZ J, ; J=0
SETZ K, ; K=0
SETZ X, ; PTR IS LOC OF PWDS(1)
MOVEI M,PTR ; DO 1 M=1,ITEM
G1: AOJ X,
MOVE L,(M) ; XRN IS LOC OF RN(1)
MOVEI R,XRN ;L=PWDS(M)
ADDI R,(L)
G9: MOVE A,2(R)
CAML A,RR4 ;R4
CAMLE A,RR4+1
JRST G2 ;9 IF(OUTLIM(R4,R5,RN(L+3)))GO TO 2
AOJ J,
; IN LIMITS?
MOVEI A,MMV-1 ;J=J+1
ADDI A,(J)
MOVEI 0,(L)
AOJ K, ;K=K+1
MOVEI 1,NNP-1
ADDI 1,(K) ;NP(K)=L
MOVEM 0,(1)
ADDI 0,3 ;N(J)=L+3
MOVEM 0,(A)
; NP IS FOR USE IN JUSTIFY ROUTINE
G2: MOVE RY,(R) ;2 IF(RY.LT.4)GO TO 1
CAML RY,[=4.0]
CAMLE RY,[=7.0]
JRST GX ;IF(RY.GT.7)GO TO 1 TWO-ENDED ITEM?
MOVE RZ,-1(R) ;RZ=RN(L) WD CNT
CAMN RY,[=4.0] ;GO TO(4,5,6,7),IFIX(RY)-3
JRST G4
CAMN RY,[=5.0]
JRST G5
CAMN RY,[=6.0]
JRST G6
CAMG RZ,[=4.0] ;4 IF(RZ.GT.2)GO TO 5
JRST G5 ; THERE IS A TRILL WIGGLE
JRST GX ;GO TO 1 -- NO WIGGLE (P7≠0)
G4: CAMG RZ,[=2.0] ;7 IF(RZ.GT.3)GO TO 5
JRST GX
JRST G5 ;GO TO 1
G6: CAMGE RZ,[=8.0] ;6 IF(RZ.LT.8)GO TO 8
JRST G8
SKIPL 6(R) ;IF(R7)GO TO 8
SKIPN =9(R) ;IF(R10.EQ.0)GO TO 8
;N MOVE 1,=9(R) ;IF(RN(L+10).LT.30)GO TO 8
; CAMGE 1,[=30.0]
JRST G8
;; MOVE A,7(R) ; IF(OUTLIM(R4,R5,RN(L+8)))GO TO 8
SKIPG A,7(R) ;IGNORE P8 IF IT IS 0 OR -
JRST G8
CAMG A,RR4+1
CAMGE A,RR4
JRST G8
AOJ J,
; IN LIMITS?
MOVEI A,MMV-1 ;J=J+1
ADDI A,(J)
MOVEI 0,(L) ;J=J+1
ADDI 0,=8 ;N(J)=L+8
MOVEM 0,(A)
G8: CAMGE RZ,[=7.0] ;8 IF(RZ.LT.7)GO TO 5
JRST G5
SKIPG A,8(R) ; R9 IF(R9.LE.0)GO TO G5
JRST G5
;;; SKIPL 6(R) ; R7
;;; SKIPN 7(R) ; R8
SKIPE 7(R) ; R8
JRST .+3
SKIPL 6(R) ; R7
JRST G5
;N MOVE A,6(R) ;IF(RN(L+7))GO TO G8B
;N JUMPL A,G8B ; P7 IS NEG FOR TREMOLO
;N MOVE A,7(R) ;IF(RN(L+8).NE.0)GO TO G8B
;N JUMPN A,G8B
;N CAMGE RZ,[=8.0]
;N JRST G5 ;IF(RZ.LT.8)GO TO G5
;N MOVE A,=9(R) ;IF(RN(L+10).EQ.0)GO TO G5
;N JUMPE A,G5 ;PASSES NUMBER OVER BEAM.
;N G8B: MOVE A,8(R)
CAMG A,RR4+1
CAMGE A,RR4 ;R4
JRST G5
AOJ J, ;J=J+1
; IN LIMITS?
MOVEI A,MMV-1 ;J=J+1
ADDI A,(J)
MOVEI 0,(L)
ADDI 0,=9 ;IF(OUTLIM(R4,R5,RN(L+9)))GO TO 5
MOVEM 0,(A) ;N(J)=L+9
G5: MOVE A,5(R)
CAMG A,RR4+1
CAMGE A,RR4 ;R4
JRST GX
AOJ J,
; IN LIMITS?
MOVEI A,MMV-1 ;J=J+1
ADDI A,(J)
MOVEI 0,(L) ;5 IF(OUTLIM(R4,R5,RN(L+6)))GO TO 1
ADDI 0,6 ;N(J)=L+6
MOVEM 0,(A)
;;;GX: CAMGE X,RR4+4 ;1 CONTINUE
GX: CAMGE X,RINP+=18 ; I
AOJA M,G1 ;RINp+=18 IS I (OR NUM OF ITEMS)
MOVEM J,KJY+1
MOVEM K,KJY
JRA 16,(16)
; SUBROUTINE MOVIT(RN,NP,R4,R5,R8,R9)
; DIMENSION NP(1),RN(1)
; COMMON /KJY/ DONT,J
MOVIT: 0 ;RDIS=(R9-R8)/(R5-R4)
MOVE R,.COMM.+3
FSBR R,.COMM.+2
MOVE RY,RR4+1
FSBR RY,RR4
FDVR R,RY
MOVEI L,MMV ; DO 1 K=1,J
SETZ K,
MOVE 0,.COMM.+3 ; SET UP R9
M1: MOVE X,L ; L=N(K)
MOVE A,(X)
MOVEI R2,XRN ;RA=RN(L)
ADDI R2,(A)
MOVEI RZ,(R2)
MOVE R2,-1(R2)
CAML R2,RR4 ;IF(OUTLIM(R4,R5,RA))GO TO 1
CAMLE R2,RR4+1
JRST MX
JUMPE 0,M2 ;IF(R9.NE.0)RA=(RA-R4)*RDIS
FSBR R2,RR4
FMPR R2,R
M2: FADR R2,.COMM.+2 ; RN(L)=R8+RA
MOVEM R2,-1(RZ)
MX: AOJ K, ;1 CONTINUE
CAMGE K,KJY+1
AOJA L,M1
JRA 16,(16)
SORT2: 0 ;SUBROUTINE SORT2(RPOS,M)
MOVEI 2,2 ;DIMENSION RPOS(2,200)
S3: MOVE 6,2 ;(K=L HERE)
SETO 11, ;L=2
HRRZI 3,@(16) ;3 J=-1
MOVE 4,2 ;RX=RPOS(1,L-1)
SUBI 4,1 ;L-1
IMULI 4,2
ADDI 4,(3)
MOVE 5,-2(4) ;RX
S2: MOVE 7,6 ; DO 2 K=L,M
;; LSH 7,1 ;IF(RPOS(1,K).GE.RX)GO TO 2
IMULI 7,2 ;IF(RPOS(1,K).GE.RX)GO TO 2
ADDI 7,(3)
CAMG 5,-2(7)
JRST S1 ; CONTINUE
MOVE 5,-2(7) ; RX=RPOS(1,K)
;;C WHY WERE ALL THE RX'S JX ????? 9/6/73
MOVE 11,6 ;J=K
S1: CAMGE 6,@1(16) ;2 CONTINUE
AOJA 6,S2
JUMPL 11,S4 ;IF(J)GO TO 4
MOVE 12,2 ;K=L-1
SOS 12
IMULI 12,2 ;(K*2)
ADD 12,3 ;CALL EXCH(RPOS(1,K),RPOS(1,J))
MOVE 10,-2(12)
;; LSH 11,1 ;MULTS BY 2 (LEFT SHIFT)
IMULI 11,2
ADD 11,3
EXCH 10,-2(11)
MOVEM 10,-2(12)
MOVE 10,-1(12) ;CALL EXCH(RPOS(2,K),RPOS(2,J))
EXCH 10,-1(11)
MOVEM 10,-1(12)
S4: CAMGE 2,@1(16) ;4 L=L+1
AOJA 2,S3 ;IF(L.LE.M)GO TO 3
JRA 16,2(16) ;END
EXCH: 0 ; SUBROUTINE EXCH(X,Y)
MOVE @(16)
EXCH 0,@1(16)
MOVEM 0,@(16)
JRA 16,2(16)
EXTEN: 0 ;FUNCTION EXTEN(X)
HRRM 16,.+2
JSA 16,AMOD ;EXTEN=AMOD(X,1.)*10.
JUMP @0
JUMP [=1.0]
FMPR [=10.0]
JRA 16,1(16)
; WRITES AND READS DUMP MODE FILES WITH ANY EXTENSION.
CH←12
CH2←11
BLKS←←=1
DEFINE ERROR (MSG)
< JSA 16,.ERROR
JUMP [ASCIZ/MSG/
]
>
REGS: BLOCK 20
;CALL PUTEXT(<FILE>,<EXT>)
PUTEXT: 0 ;USES EXTOUT,FINEXT, CH2
MOVE 0,@0(16)
MOVEM 0,FILNAM
MOVE 0,@1(16)
MOVEM 0,EXTNAM
JSA 16,INTFIL
SETZM DIR+2
SETZM DIR+3
ENTER CH2,DIR
ERROR <ENTER FAILED>
JRA 16,2(16)
DIR: BLOCK 4
;CALL EXTOUT(<ARRAY>,<NO. OF WORDS>)
EXTOUT: 0
HRRZ 0,0(16)
SUBI 0,1
MOVEM 0,COM
MOVN 0,@1(16)
HRLM 0,COM
OUTPUT CH2,COM
STATZ CH2,740000
ERROR <WRITE ERROR>
JRA 16,2(16)
INTFIL: 0 ;INITS DSK
MOVEI REGS
BLT REGS+3
INIT CH2,17
SIXBIT/DSK/
0
ERROR <CAN'T INIT DSK!>
INTF4: MOVE 0,FILNAM#
MOVEM 0,FN#
MOVE 1,[POINT 7,FN]
INTF3: MOVE 2,[POINT 6,DIR]
SETZM DIR
MOVEI 3,5
INTF1: ILDB 0,1
CAIN 0," "
JRST INTF2
SUBI 0,40
IDPB 0,2
SOJG 3,INTF1
INTF2: HRLZI REGS
BLT 3
MOVE 0,EXTNAM#
MOVEM 0,EX#
MOVE 1,[POINT 7,EX]
EXTF3: MOVE 2,[POINT 6,DIR+1]
SETZM DIR+1
MOVEI 3,5
EXTF1: ILDB 0,1
CAIN 0," "
JRST EXTF2
SUBI 0,40
IDPB 0,2
SOJG 3,EXTF1
EXTF2: HRLZI REGS
BLT 3
JRA 16,0(16)
COM: OCT 0,0
COM1: 0
BLKNUM: 0
;CALL FINEXT
FINEXT: 0
CLOSE CH2,0
STATZ CH2,740000
ERROR <ERROR AFTER CLOSE>
RELEASE CH2,0
JRA 16,0(16)
;CALL GETEXT(<FILE>,<EXT>)
GETEXT: 0
MOVE 0,@0(16)
MOVEM 0,FILNAM
MOVE 0,@1(16)
MOVEM 0,EXTNAM
JSA 16,INTFIZ
SETZM DIR+3
SETZM DIR+2
LOOKUP CH,DIR
ERROR <LOOKUP FAILED>
JRA 16,2(16)
INTFIZ: 0 ;INITS DSK FOR INPUT
MOVEI REGS
BLT REGS+3
INIT CH,17
SIXBIT/DSK/
0
ERROR <CAN'T INIT DSK!>
JRST INTF4
;CALL FASTI2(<ARRAY>,<NO. WORDS>)
EXTIN: 0
HRRZ 0,0(16)
SUBI 0,1
MOVEM 0,COM
MOVN 0,@1(16)
HRLM 0,COM
INPUT CH,COM
STATZ CH,740000
0
JRA 16,2(16)
.ERROR: 0
OUTSTR [ASCIZ/?
/] ;MAKE SURE HE CAN SEE HIS ERROR
OUTSTR @(16) ;OUTPUT ERROR MESSAGE
CALLI 1,12 ;LET USER CONTINUE
JRA 16,1(16)
END